home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 4 / Meeting Pearls Vol. IV (1996)(GTI - Schatztruhe)[!].iso / Pearls / dev / Oberon / OberonV4 / system / Input.Mod (.txt) < prev    next >
Oberon Text  |  1996-05-28  |  6KB  |  188 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. ParcElems
  4. Alloc
  5. MODULE Input;   (*cn/shml 5 May 93 Amiga*)
  6.  IMPORT
  7.    O:=Console, SYSTEM, Amiga, Exec := AmigaExec, I := AmigaIntuition, IE := AmigaInputEvent, Console := AmigaConsole;
  8.  CONST
  9.   TimeUnit*= 1000;  (*resolution of Time() is one millisecond*)
  10.   ESC = 1BX; SETUP = 0A4X; FF = 0CX; Quit = 0EFX;
  11.   QueueLen = 128;
  12.   MR = 0; MM = 1; ML = 2;
  13.   CUP=0C1X; CDOWN=0C2X; CLEFT=0C4X; CRIGHT=0C3X;
  14.   BREAK1=0ACX; BREAK2=0ADX;
  15.   DEL = 07FX; BS=08X;
  16.  TYPE
  17.    IntuiMessagePtr=POINTER TO I.IntuiMessage;
  18.    WindowPtr=POINTER TO I.Window;
  19.   mouseKeys: SET;
  20.   keyIn, keyOut: INTEGER;
  21.   keyQueue: ARRAY QueueLen OF CHAR;
  22.   micros0,sec0:LONGINT;
  23.   mouseX, mouseY: INTEGER;
  24.   R2O: ARRAY 256 OF CHAR;
  25.  PROCEDURE InitConsole;
  26.   VAR ir: Exec.IOStdReq;
  27.  BEGIN
  28.   IF Exec.OpenDevice(Console.consoleName, -1, SYSTEM.VAL(Exec.MessagePtr,SYSTEM.ADR(ir)), {}) # 0 THEN HALT(99) END;
  29.   Console.consoleBase := ir.device
  30.  END InitConsole;
  31.  PROCEDURE DeadKeyConvert(msg: IntuiMessagePtr; VAR buf: ARRAY OF CHAR): LONGINT;
  32.  TYPE
  33.   LPtr=POINTER TO RECORD l:LONGINT END;
  34.   ie: IE.InputEventAdr;
  35.   len: LONGINT;
  36.   p:LPtr;
  37.  BEGIN
  38.    IF ODD(ASH(msg.class,-I.rawKey)) & ~ODD(msg.code DIV IE.upPrefix) THEN
  39.      ie.nextEvent := NIL; ie.subClass := 0; ie.class := IE.rawkey;
  40.      ie.code := msg.code; ie.qualifier := msg.qualifier;
  41.      p:=SYSTEM.VAL(LPtr,msg.iAddress);
  42.      ie.addr := p.l;
  43.      len:=Console.RawKeyConvert(SYSTEM.ADR(ie), buf, LEN(buf), 0(*NIL*))
  44.    ELSE
  45.     len:=0
  46.    END;
  47.    RETURN len
  48.  END DeadKeyConvert;
  49.  PROCEDURE AddKeyToQueue(buf:ARRAY OF CHAR; len:LONGINT);
  50.   i:LONGINT;
  51.  BEGIN
  52.   i := 0;
  53.   WHILE (len > 0) & ((keyIn-keyOut) MOD QueueLen # QueueLen-1) DO
  54.    keyQueue[keyIn] := buf[i];
  55.    keyIn := (keyIn+1) MOD QueueLen;
  56.    INC(i);
  57.    DEC(len)
  58.   END
  59.  END AddKeyToQueue;
  60.  PROCEDURE PollIDCMP(wait:BOOLEAN);
  61.   VAR
  62.    msg: IntuiMessagePtr;
  63.    len, dummy: LONGINT;
  64.    Qualis: SET;
  65.    buf: ARRAY 32 OF CHAR;
  66.    win: WindowPtr;
  67.  BEGIN
  68.   win := SYSTEM.VAL(WindowPtr, Amiga.window);
  69.   LOOP
  70.    IF wait THEN Exec.WaitPort(win.userPort) END;
  71.    msg := SYSTEM.VAL(IntuiMessagePtr, Exec.GetMsg(win.userPort));
  72.    IF msg = NIL THEN
  73.        mouseX:=win.mouseX; mouseY:=win.mouseY;
  74.         EXIT
  75.    END;
  76.    IF ODD(ASH(msg.class,-I.mouseButtons)) THEN
  77.     CASE msg.code OF
  78.     | I.selectDown: INCL(mouseKeys, ML)
  79.     | I.selectUp: EXCL(mouseKeys, ML)
  80.     | I.menuDown: INCL(mouseKeys, MR)
  81.     | I.menuUp: EXCL(mouseKeys, MR)
  82.     | I.middleDown: INCL(mouseKeys, MM)
  83.     | I.middleUp: EXCL(mouseKeys, MM)
  84.     END;
  85.     mouseX:=msg.mouseX; mouseY:=msg.mouseY;
  86.     EXIT
  87.    ELSIF ODD(ASH(msg.class,-I.rawKey)) THEN
  88.     dummy:=msg.qualifier; Qualis:=SYSTEM.VAL(SET, dummy);
  89.     IF (msg.code = 64H) & Amiga.useLAltAsMouse THEN  (* left alt key pressed *)
  90.      INCL(mouseKeys, MM)
  91.     ELSIF (msg.code = 64H+IE.upPrefix) & Amiga.useLAltAsMouse THEN (* left alt key released *)
  92.      EXCL(mouseKeys, MM)
  93.     ELSIF msg.code = 52H THEN  (* F3 key pressed *)
  94.      IF (msg.qualifier MOD 4)#0 THEN (* one of the shift keys pressed *)
  95.       AddKeyToQueue(BREAK2, 1)
  96.      ELSE
  97.       AddKeyToQueue(BREAK1, 1)
  98.      END;
  99.      wait:=FALSE
  100.     ELSIF R2O[msg.code]#CHR(0) THEN (* map Raw-Key to Oberon Char *)
  101.       buf[0]:=R2O[msg.code];
  102.       AddKeyToQueue(buf, 1);
  103.       wait:=FALSE
  104.     ELSIF (IE.rCommand IN Qualis) & (msg.code>=32H) & (msg.code<=34H) THEN
  105.       buf[0]:=CHR(msg.code-32H+0FCH);
  106.       AddKeyToQueue(buf, 1);
  107.       wait:=FALSE
  108.     ELSE                                            (* normal Keys *)
  109.      len := DeadKeyConvert(msg, buf);
  110.      Amiga.ConvertAnsiToOberon(buf,len);
  111.      AddKeyToQueue(buf,len);
  112.      IF len>0 THEN
  113.       (*
  114.        We now have gotten some keys, so Read, which is the only procedure
  115.        calling PollIDCMP with wait=TRUE, will surely get it's character,
  116.        so no further waiting is needed.
  117.       *)
  118.       wait:=FALSE
  119.      END
  120.     END
  121.    ELSIF ODD(ASH(msg.class,-I.closeWindow)) THEN
  122.      AddKeyToQueue(Quit, 1);
  123.      wait:=FALSE
  124.    END;
  125.    Exec.ReplyMsg(SYSTEM.VAL(Exec.MessagePtr, msg))
  126.   END
  127.  END PollIDCMP;
  128.  PROCEDURE Available*(): INTEGER;
  129.   len:INTEGER;
  130.  BEGIN
  131.   PollIDCMP(FALSE);
  132.   len:= (keyIn-keyOut) MOD QueueLen;
  133.   RETURN len
  134.  END Available;
  135.  PROCEDURE Read*(VAR ch: CHAR);
  136.  BEGIN
  137.   PollIDCMP(keyIn=keyOut); (* wait if keyboard queue empty *)
  138.   ch := keyQueue[keyOut];
  139.   keyOut := (keyOut+1) MOD QueueLen;
  140.  END Read;
  141.  PROCEDURE Mouse*(VAR keys: SET; VAR x, y: INTEGER);
  142.   VAR win: WindowPtr;
  143.  BEGIN
  144.   PollIDCMP(FALSE);
  145.   win := SYSTEM.VAL(WindowPtr, Amiga.window);
  146.   x := (*win.*)mouseX-win.borderLeft;
  147.   y := win.height-(*win.*)mouseY-1-win.borderBottom;
  148.   keys := mouseKeys;
  149.   IF y>=Amiga.Height THEN y:=Amiga.Height-1 ELSIF y<0 THEN y:=0 END;
  150.   IF x>=Amiga.Width THEN x:=Amiga.Width-1 ELSIF x<0 THEN x:=0 END
  151.  END Mouse;
  152.  PROCEDURE SetMouseLimits*(w, h: INTEGER);
  153.  END SetMouseLimits;
  154.  PROCEDURE Time*(): LONGINT;
  155.   VAR sec, micros: LONGINT;
  156.  BEGIN
  157.   I.CurrentTime(sec, micros);
  158.   DEC(sec,sec0); DEC(micros,micros0);
  159.   RETURN sec*TimeUnit + micros DIV (1000000 DIV TimeUnit)
  160.  END Time;
  161.     PROCEDURE InitRAWtoOberon;    (* Map RAW-Key to Oberon Char *)
  162.         VAR i: INTEGER;
  163.     BEGIN
  164.     FOR i:=0 TO 255 DO R2O[i]:=CHR(0) END;
  165.     R2O[50H]:=SETUP;    (* F1 *)
  166.     R2O[51H]:=ESC;    (* F2 *)
  167.     R2O[53H]:=SETUP;    (* F4 *)
  168.     R2O[54H]:=0F5X;    (* F5 *)
  169.     R2O[55H]:=0F6X;    (* F6 *)
  170.     R2O[56H]:=0F7X;    (* F7 *)
  171.     R2O[57H]:=0F8X;    (* F8 *)
  172.     R2O[58H]:=0F9X;    (* F9 *)
  173.     R2O[59H]:=0FAX;    (* F10 *)
  174.     R2O[5FH]:=0FBX;    (* HELP *)
  175.     R2O[46H]:=BS;    (* DEL *)
  176.     R2O[41H]:=DEL;    (* BackSpace *)
  177.     R2O[4CH]:=CUP;    (* Cursor UP *)
  178.     R2O[4DH]:=CDOWN;    (* Cursor DOWN *)
  179.     R2O[4FH]:=CLEFT;    (* Cursor LEFT *)
  180.     R2O[4EH]:=CRIGHT;    (* Cursor RIGHT *)
  181.     END InitRAWtoOberon;
  182. BEGIN
  183.  I.CurrentTime(sec0,micros0);
  184.  InitConsole;
  185.  keyIn := 0; keyOut := 0; mouseKeys := {};
  186.  InitRAWtoOberon
  187. END Input.
  188.